home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / apps / circuits / spice2g6.z / spice2g6 / spice / Fortran / pheadr.f < prev    next >
Encoding:
Text File  |  1989-02-03  |  4.8 KB  |  137 lines
  1.       subroutine pheadr(aheadr)
  2.       implicit double precision (a-h,o-z)
  3. c spice version 2g.6  sccsid=tabinf 3/15/83
  4.       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
  5.      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
  6.      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
  7.      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
  8.      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
  9.      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval,
  10.      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt,
  11.      7   irowno,jcolno,nttbr,nttar,lvntmp
  12. c spice version 2g.6  sccsid=cirdat 3/15/83
  13.       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
  14.      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc
  15. c spice version 2g.6  sccsid=status 3/15/83
  16.       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet,
  17.      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon,
  18.      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile
  19. c spice version 2g.6  sccsid=dc 3/15/83
  20.       common /dc/ tcstar(2),tcstop(2),tcincr(2),icvflg,itcelm(2),kssop,
  21.      1   kinel,kidin,kovar,kidout
  22. c spice version 2g.6  sccsid=miscel 3/15/83
  23.       common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad,
  24.      1  defas,rstats(50),iwidth,lwidth,nopage
  25. c spice version 2g.6  sccsid=blank 3/15/83
  26.       common /blank/ value(200000)
  27.       integer nodplc(64)
  28.       complex cvalue(32)
  29. c int3 (not used) is strictly for alignment.  f77 on unix craps out.
  30.       integer int2,int3,nodpl2(128)
  31.       equivalence (value(1),nodpl2(1))
  32.       equivalence (value(1),nodplc(1),cvalue(1))
  33.       dimension aheadr(10)
  34. c
  35. c  put out the header records onto the post-processing file
  36. c  routine is used for all analysis modes (mode=1,2,3)
  37. c
  38.       dimension xtype(2)
  39.       data xtype /4htime,4hfreq/
  40.       data ablnk,aletv,aleti /1h ,1hv,1hi/
  41. c
  42. c file structure for post-processor
  43. c
  44. c record 1  title card (80 bytes), date (8 bytes), time (8 bytes) total-96 bytes
  45. c record 2  number of output variables (including "sweep" variable)
  46. c record 3  integer '4' (2 bytes)
  47. c record 4  names of each output variable (8 bytes ea.)
  48. c record 5  type of each output       0-no type
  49. c                                     1-time
  50. c                                     2-frequency
  51. c                                     3-voltage
  52. c                                     4-current
  53. c                                     5-output noise
  54. c                                     6-input noise
  55. c                                     7-hd2    |
  56. c                                     8-hd3    |
  57. c                                     9-dim2   }   distortion outputs
  58. c                                    10-sim2   |
  59. c                                    11-dim3   |
  60. c record 6  the location of each variable within each sweep point.
  61. c           (normally just 1,2,3,4,... but needed if outputs are mixed up)
  62. c record 6a 24 characters that are the plot title if record 3 is a '4'.
  63. c record 7  output at first sweep point
  64. c record 8  output at second sweep point
  65. c record 9  .
  66. c           .
  67. c           .
  68. c last record
  69. c
  70. c
  71.       call getm8(ibuff,12)
  72.       call copy8(aheadr(1),value(ibuff+1),10)
  73.       value(ibuff+11)=adate
  74.       value(ibuff+12)=atime
  75.       call fwrite(value(ibuff+1),48)
  76.       numout=nunods+jelcnt(9)
  77. c force nused to be allocated by useless usage.
  78.       int2 = numout
  79.       int3 = numout
  80.       info=4
  81.       call getm8(inames,numout)
  82.       call getm4(itypes,numout)
  83.       call getm4(iseqs,numout)
  84.       itype2=itypes*2
  85.       iseq2=iseqs*2
  86.       iknt=1
  87.       nodpl2(iseq2+1)=1
  88. c
  89. c dc transfer curve (mode = 1):
  90. c
  91.       if(mode.ne.1) go to 10
  92.       loc=itcelm(1)
  93.       locv=nodplc(loc+1)
  94.       value(inames+1)=value(locv)
  95.       anam=ablnk
  96.       call move(anam,1,value(locv),1,1)
  97.       ityp=0
  98. c voltage transfer becomes type 3 and current transfer becomes 4.
  99.       if(anam.eq.aletv) ityp=3
  100.       if(anam.eq.aleti) ityp=4
  101.       nodpl2(itype2+1)=ityp
  102.       go to 20
  103.    10 value(inames+1)=xtype(mode-1)
  104.       nodpl2(itype2+1)=mode-1
  105.    20 do 30 i=2,nunods
  106.       nodpl2(itype2+i)=3
  107.       nodpl2(iseq2+i)=i
  108.       value(inames+i)=ablnk
  109.       ipos=1
  110.       call alfnum(nodplc(junode+i),value(inames+i),ipos)
  111.    30 continue
  112.       loc=locate(9)
  113.       iknt=nunods
  114.    40 if(loc.eq.0) go to 50
  115.       iknt=iknt+1
  116.       nodpl2(itype2+iknt)=4
  117.       nodpl2(iseq2+iknt)=iknt
  118.       locv=nodplc(loc+1)
  119.       value(inames+iknt)=value(locv)
  120.       loc=nodplc(loc)
  121.       go to 40
  122.    50 int2=numout
  123.       call fwrite(int2,1)
  124.       int2=info
  125.       call fwrite(int2,1)
  126.       nwds=numout*4
  127.       call fwrite(value(inames+1),nwds)
  128.       call fwrite(nodpl2(itype2+1),numout)
  129.       call fwrite(nodpl2(iseq2+1),numout)
  130.       call fwrite(aprog(1),12)
  131.       call clrmem(ibuff)
  132.       call clrmem(inames)
  133.       call clrmem(itypes)
  134.       call clrmem(iseqs)
  135.       return
  136.       end
  137.